home *** CD-ROM | disk | FTP | other *** search
/ User's Choice Windows CD / User's Choice Windows CD (CMS Software)(1993).iso / windows3 / om38a.zip / OM.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-14  |  40KB  |  1,324 lines
  1. {OttoMenu - A Win 3.1 Menu }
  2. {Rel 3.8} {tabs = 2}
  3. program OttoMenu;
  4. {$S-}{$R om.RES}{$R-}{$X+}{$V-}
  5. {$D OttoMenu Copyright (C) Doug Overmyer 12/17/91}
  6. uses WinTypes,WinProcs,Strings,WObjects,WinDos,filecopy,WFPlus,Buttons,
  7.     SclpText,WIN31,ShellAPI,Bitmap,CommDlg;
  8. const
  9.     id_BMP       = 99;
  10.   id_RGB       = 100;
  11.     id_ButOffset = 120;
  12.      id_But0    = 200;     {Base value of Icon buttons   }
  13.   id_But1    = 201;     {User defined button 1 iconbar}
  14.   id_But2    = 202;     {      "             2 iconbar}
  15.   id_But3    = 203;     {      "             3 iconbar}
  16.   id_But4    = 204;     {      "             3 iconbar}
  17.   id_But5    = 205;     {      "             5 iconbar}
  18.   id_But6    = 206;     {User defined button 6 iconbar}
  19.   id_But7    = 207;     {      "             7 iconbar}
  20.   id_But8    = 208;     {      "             8 iconbar}
  21.   id_But9    = 209;     {      "             9 iconbar}
  22.   id_But10   = 210;     {      "            10 iconbar}
  23.   id_But11   = 211;     {      "            11        }
  24.   id_But12   = 212;     {                   12        }
  25.   id_But13   = 213;     {                   13        }
  26.   id_But14   = 214;     {                   14        }
  27.   id_But15   = 215;     {                   15        }
  28.   id_But21   = 221;     {page 1 icon}
  29.   id_But22   = 222;     {page 2 icon}
  30.   id_But23   = 223;     {page 3 icon}
  31.   id_But24   = 224;     {page 4 icon}
  32.   id_Gb1     = 300;     {group box for radio buttons}
  33.   id_GB2     = 200;     {group box for page icons}
  34.   id_St1     = 401;     {Static text 1         icon bar}
  35.   id_St2     = 402;     {Static text 2         icon bar}
  36.   id_Pict    = 501;
  37.   id_D1      = 550;     {Dlg1 - Autoiconize & Setfonts}
  38.   id_D1RB1   = 551;     { autoiconize}
  39.   id_D1RB2   = 552;     { don't }
  40.   id_D1SetFont = 553;   { SetFont button}
  41.   id_D2OK    = 601;     {Dlg2 - Properties  }
  42.   id_D2Browse= 650;     { browse button}
  43.   id_D2EC1   = 603;     { item #}
  44.   id_D2EC2   = 605;     { Name}
  45.   id_D2EC3   = 607;     { file}
  46.   id_D2EC4   = 609;     { Start directory}
  47.   id_D2EC5   = 617;     { parameters}
  48.   id_D2EC6   = 621;     { start size}
  49.   id_D3LB1   = 701;     {Dlg3 - Drive Space}
  50.   idm_About  = 801;     {menu id for OM_Abut menu}
  51.   id_Timer   = 901;     {timer id}
  52. {************************  Types    ************************}
  53. type
  54. TOMApplication = object(TApplication)
  55.       SplashRect: TRect;
  56.   procedure InitApplication;virtual;
  57.   procedure InitMainWindow;virtual;
  58.   procedure Redraw;
  59. end;
  60.  
  61. ItemRec = record
  62. ItemNum,PgmName,PgmFile,Dir,Params,Cmdshow:Array[0..69] of Char;
  63. end;
  64.  
  65. PPgmItem = ^TPgmItem;
  66. TPgmItem = object(TObject)
  67.         PgmName:PChar;
  68.       PgmFile:PChar;
  69.       Dir:PChar;
  70.       Params:PChar;
  71.       CmdShow:PChar;
  72.   constructor Init(NewPgmName,NewPgmFile,NewDir,NewParams,NewCmdShow:PChar);
  73.   destructor Done;virtual;
  74. end;
  75.  
  76. POMCol = ^TOMCol;
  77. TOMCol = object(TCollection)
  78.         IniFile:Array[0..79] of Char;
  79.         TheItems:PCollection;
  80.     constructor Init(ALimit,ADelta:Integer;NewIniFile:PChar);
  81.   destructor Done;virtual;
  82.   function At(Indx:Integer):PPgmItem;virtual;
  83.   procedure ReadItems(Start,Finish:Integer);virtual;
  84.     procedure ItemGet(var PgmItem:ItemRec);virtual;
  85.     procedure ItemSet(PgmItem:ItemRec);virtual;
  86.   function GetCount:Integer;virtual;
  87.   function IsValidIndx(Indx:Integer):Boolean;
  88. end;
  89.  
  90. POMDlg1 = ^TOMDlg1;
  91. TOMDlg1 = object(TDialog)
  92.     procedure IDSetFont(var Msg:TMessage);virtual id_first+id_D1SetFont;
  93. end;
  94.  
  95. POMDlg2 = ^TOMDlg2;
  96. TOMDlg2 = object(TDialog)              {Item setup dialog}
  97.         EC1,EC2,EC3,EC4,EC5,EC6:PEdit;
  98.   constructor Init(AParent:PWindowsObject;AName:PChar);
  99.   procedure IDD2OK(var Msg:TMessage); virtual id_First+id_D2OK;
  100.   procedure IDBrowse(var Msg:TMessage);virtual id_First+id_D2Browse;
  101. end;
  102.  
  103. POMDlg3 = ^TOMDlg3;
  104. TOMDlg3 = object(TDialog)              {Run dialog}
  105.     procedure SetupWindow; virtual;
  106. end;
  107.  
  108. POMAboutDlg = ^TOMAboutDlg;
  109. TOMAboutDlg = object(TDialog)
  110.         Logo:HBitmap;
  111.   constructor Init(AParent:PWindowsObject;AName:PChar;ALogo:HBitmap);
  112.     procedure WMCtlColor(var Msg:TMessage);virtual wm_First+wm_CtlColor;
  113. end;
  114.  
  115. POMRButton = ^TOMRButton;
  116. TOMRButton = object(TRadioButton)
  117.     procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  118. end;
  119.  
  120. POMGroupBox = ^TOMGroupBox;
  121. TOMGroupBox = object(TGroupBox)
  122.     procedure SetupWindow;virtual;
  123.   function CanClose:Boolean;virtual;
  124.   procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  125. end;
  126.  
  127. POMStatic = ^TOMStatic;
  128. TOMStatic = object(TSText)
  129.     procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  130. end;
  131.  
  132. type
  133. POMWindow = ^TOMWindow;
  134. TOMWindow = object(TWindow)
  135.       BN1:Array[0..10] of PODDButton;  {icon bar button pointers}
  136.       BN2:Array[0..5] of PODButton;
  137.       BNR:Array[0..5] of PODDButton; {page icons}
  138.       GB1:POMGroupBox;
  139.       GB2:PODDGroupBox;
  140.       RB:Array[0..20] of POMRButton; {radio button pointers id's 301-320}
  141.       ST1:POMStatic;
  142.     St2:POMStatic;
  143.       Apps:POMCol;
  144.       Logo,Pict:HBitmap;
  145.       PictRect,MPR:TRect;
  146.       PageNum,AutoMin:Integer;
  147.       TheFont:HFont;
  148.       D2TfB:ItemRec;
  149.       Bitmap:PTBMP;
  150.       StatDisp:Char;
  151.       IniFile:Array[0..79] of Char;
  152.       BkBrush:HBrush;
  153.       LogFont:TLogFont;
  154.       FontSize:Integer;
  155.     constructor Init(AParent:PWindowsObject;ATitle:PChar);
  156.   destructor Done;virtual;
  157.   procedure SetupWindow;virtual;
  158.   function GetClassName:PChar;virtual;
  159.   procedure SetRBText;virtual;
  160.   procedure Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  161.   procedure SetStaticText;
  162.   procedure    WMDrawItem(var Msg:TMessage);virtual wm_First + wm_DrawItem;
  163.     procedure IDBut11(var Msg:TMessage);virtual id_First+id_But11; { }
  164.   procedure IDBut12(var Msg:TMessage);virtual id_First+id_But12; { }
  165.   procedure    IDBut13(var Msg:TMessage);virtual id_First+id_But13; { }
  166.   procedure IDBut14(var Msg:TMessage);virtual id_First+id_But14; { }
  167.   procedure IDBut15(var Msg:TMessage);virtual id_First+id_But15; {Free Icon}
  168.   procedure DefChildProc(var Msg:TMessage);virtual;
  169.   procedure WinExecc(var Msg:TMessage);virtual;
  170.   procedure    WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  171.   procedure SetItemValues(PgmItem:ItemRec);virtual;
  172.     procedure WMCtlColor(var Msg:TMessage);virtual wm_First+wm_CtlColor;
  173.   procedure RunIt;virtual;
  174.   procedure UMDropFiles(var Msg:TMessage);virtual wm_User+wm_Dropfiles;
  175.     procedure UMRButtonDown(var Msg:TMessage);virtual wm_User+wm_RButtonDown;
  176.     procedure LoadBMP(BMPName:PChar);
  177.   function CtrlToIndx(Id:Integer):Integer;virtual;
  178.   procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  179.   procedure SetStatProp(var Msg:TMessage);virtual;
  180.   procedure SetButProp(var Msg:TMessage);virtual;
  181.   procedure SetBMPProp(var Msg:TMessage);virtual;
  182.   procedure SetRGBProp(var Msg:TMessage);virtual;
  183.   procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  184.   procedure GetPictRect;virtual;
  185.   procedure CreateBrush(BkgndColor:PChar);virtual;
  186.   procedure WMNCRButtonDown(var Msg:TMessage);virtual wm_First+wm_NCRButtonDown;
  187.   procedure WMEraseBkGnd(var Msg:TMessage);virtual wm_First+wm_EraseBkGnd;
  188.   procedure WMTimer(var Msg:TMessage);virtual wm_First+wm_Timer;
  189.   procedure UMSetFont(var Msg:TMessage);virtual WM_USER+ID_D1SETFONT;
  190. end;
  191. {***********************  functions  *******************************}
  192. function MakeRect(L,T,R,B:Integer;Rect:PRect):PRect;
  193. begin
  194.     Rect^.left := L;
  195.   Rect^.top := T;
  196.   Rect^.right := R;
  197.   Rect^.bottom := B;
  198.   MakeRect := Rect;
  199. end;
  200. {***********************  Methods    *******************************}
  201. procedure TOMApplication.InitApplication;
  202. var
  203.   DC, MemDC: HDC;
  204.   OldBitMap, BitMap: HBitMap;
  205.   BM: TBitMap;
  206. begin
  207.   DC := CreateDC('Display', Nil, Nil, Nil);
  208.   BitMap := LoadBitMap(HInstance, 'OM_Logo');
  209.   MemDC := CreateCompatibleDC(DC);
  210.   OldBitMap := SelectObject(MemDC, BitMap);
  211.   GetObject(BitMap, SizeOf(BM), @BM);
  212.   with SplashRect do
  213.   begin
  214.     Left := 200;
  215.     Top := 150;
  216.     Right := Left + BM.bmWidth;
  217.     Bottom := Top + BM.bmHeight;
  218.     BitBlt(DC, Left, Top, BM.bmWidth, BM.bmHeight, MemDC, 0, 0, SRCCopy);
  219.   end;
  220.   DeleteObject(SelectObject(MemDC, OldBitMap));
  221.   DeleteDC(MemDC);
  222.   DeleteDC(DC);
  223.   TApplication.InitApplication;
  224. end;
  225.  
  226. procedure TOMApplication.InitMainWindow;
  227. begin
  228.     MainWindow := New(POMWindow,Init(nil,'OttoMenu'));
  229. end;
  230.  
  231. procedure TOMApplication.Redraw;
  232. begin
  233.     if SplashRect.left = 200 then
  234.         InvalidateRect(0,@SplashRect,True);
  235. end;
  236. {**********************  TOMWindow  *******************************}
  237. constructor TOMWindow.Init(AParent:PWindowsObject;ATitle:PChar);
  238. Const
  239.     BMP:Array[0..25] of PChar = ('','','','','','','','','','','',
  240.   'OM_B1','OM_B2','OM_B3', 'OM_B4', 'OM_B5',
  241.   '','','','','',
  242.   'OM_B21', 'OM_B22','OM_B23','OM_B24','');
  243. {bitmaps OM_B1 to OM_B5 are 34 x 34 16 color resources}
  244. var
  245.   TheBmp:HBitmap;
  246.   Buf:Array[0..69] of Char;
  247.   Indx,ErrCode:Integer;
  248.   TheItem:PPgmItem;
  249.   Buf1:Array[0..80] of Char;
  250. begin
  251.     TWindow.Init(AParent,ATitle);
  252.   Attr.Menu := 0; {LoadMenu(HInstance,'OM_Menu');}
  253.   Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 325;
  254.   Attr.Style := ws_Overlapped or ws_SysMenu or ws_MinimizeBox;
  255.  
  256.   StrCopy(IniFile,'OM.INI');
  257.     if StrLen(CmdLine) <> 0 then StrCopy(IniFile,CmdLine);
  258.     Logo := 0;Pict := 0;PageNum := 1;BkBrush := 0;
  259.  
  260.   Apps := New(POMCol,Init(111,20,IniFile));
  261.   Apps^.ReadItems(0,110);
  262.   For Indx := 0 to 10 do BN1[Indx] := nil;
  263.   For Indx := 0 to 5 do BN2[Indx] := nil;
  264.   For Indx := 0 to 4 do BNR[Indx] := nil;
  265.   For Indx := 0 to 20 do RB[Indx] := nil;
  266.   For Indx := 1 to 10 do
  267.       begin
  268.     TheItem := Apps^.At(Indx+80);
  269.       BN1[Indx]:=New(PODDButton,Init(@Self,id_GB2+Indx,'',Pred(Indx)*35,0,35,35,False,TheItem^.PgmFile,nil));
  270.       end;
  271.     For Indx := 1 to 5 do
  272.       BN2[Indx]:=New(PODButton,Init(@Self,id_GB2+10+Indx,'',Pred(Indx)*35,35,35,35,False,BMP[Indx+10],nil));
  273.   GB2 := New(PODDGroupBox,Init(@Self,id_Gb2,'',0,35,34,34));
  274.   For Indx := 1 to 4 do
  275.       begin
  276.     TheItem := Apps^.At(Indx+100);
  277.     if TheItem^.Pgmfile = nil then
  278.             BNR[Indx] := New(PODDButton,Init(@Self,Indx+220,'',0,35,35,35,False,BMP[Indx+20],GB2))
  279.     else
  280.             BNR[Indx] := New(PODDButton,Init(@Self,Indx+220,'',0,35,35,35,False,TheItem^.PgmFile,GB2));
  281.     end;
  282.   St1 := New(POMStatic,Init(@Self,id_St1,'',355,5,235,25,sr_Recessed,
  283.               dt_Center or dt_VCenter or dt_SingleLine));
  284.   GB1 := New(POMGroupBox,Init(@Self,id_Gb1,'',200,50,350,230));
  285.   St2 := New(POMStatic,Init(@Self,id_St2,'',220,54,150,20,SR_Recessed,
  286.               dt_Center or dt_VCenter or dt_SingleLine));
  287.   For Indx := 1 to 10 do
  288.       RB[Indx]:=New(POMRButton,Init(@Self,(id_GB1+Indx),'',215,(75+Pred(Indx)*20),160,20,GB1));
  289.   For Indx := 11 to 20 do
  290.       RB[Indx]:=New(POMRButton,Init(@Self,(id_GB1+Indx),'',385,(75+(Indx-11)*20),160,20,GB1));
  291.  
  292.     AutoMin :=Min(2,GetPrivateProfileInt('OM','AutoMin',0,IniFile));
  293.   BNR[1]^.State := 1;
  294.   GB2^.SelectionChanged(id_But21);
  295.     GetPrivateProfileString('OM','StatDisp','M',Buf,SizeOf(Buf),IniFile);
  296.   StatDisp := Buf[0];
  297.  
  298.     FontSize:= GetPrivateProfileInt('OM','FontSize',80,IniFile);
  299.   with LogFont do
  300.       begin
  301.     GetPrivateProfileString('OM','lfHeight','',Buf1,sizeof(Buf1),IniFile);
  302.     Val(Buf1,lfHeight,errcode);
  303.     lfWidth := GetPrivateProfileInt('OM','lfWidth',0,IniFile);
  304.     lfEscapement := GetPrivateProfileInt('OM','lfEscapement',0,IniFile);
  305.     lfOrientation := GetPrivateProfileInt('OM','lfOrientation',0,IniFile);
  306.  
  307.     lfWeight := GetPrivateProfileInt('OM','lfWeight',0,IniFile);
  308.     lfItalic := GetPrivateProfileInt('OM','lfItalic',0,IniFile);
  309.     lfUnderLine := GetPrivateProfileInt('OM','lfUnderline',0,IniFile);
  310.     lfStrikeout := GetPrivateProfileInt('OM','lfStrikeout',0,IniFile);
  311.  
  312.     lfCharSet := GetPrivateProfileInt('OM','lfCharSet',0,IniFile);
  313.     lfOutPrecision := GetPrivateProfileInt('OM','lfOutPrecision',0,IniFile);
  314.     lfClipPrecision := GetPrivateProfileInt('OM','lfClipPrecision',0,IniFile);
  315.     lfQuality := GetPrivateProfileInt('OM','lfQuality',0,IniFile);
  316.     lfPitchAndFamily := GetPrivateProfileInt('OM','lfPitchAndFamily',0,IniFile);
  317.     GetPrivateProfileString('OM','lfFaceName','System',lfFaceName,sizeof(lfFaceName),IniFile);
  318.   end;
  319. end;
  320.  
  321. function TOMWindow.GetClassName:Pchar;
  322. begin
  323.     GetClassName := 'OMWindow';
  324. end;
  325.  
  326. procedure TOMWindow.SetupWindow;
  327. var
  328.     SysMenu:hMenu;
  329.   Indx:Word;
  330.   CR:TRect;
  331.   NewTop,cModule:Integer;
  332.   Msg:TMessage;
  333.   Buf:Array [0..79] of Char;
  334. begin
  335.     TWindow.SetupWindow;
  336.   if GetModuleUsage(HInstance)=1 then
  337.         SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'OM_Icon'));
  338.     GetPrivateProfileString('OM','BkgndColor','12632256',Buf,SizeOf(Buf),IniFile);
  339.   CreateBrush(Buf);
  340.   Sysmenu := GetSystemMenu(hWindow,false);
  341.   AppendMenu(SysMenu,MF_Separator,0,nil);
  342.   AppendMenu(Sysmenu,0,idm_About,'About...');
  343.   TheFont := CreateFontIndirect(LogFont);
  344.   GetClientRect(HWindow,CR);
  345.   NewTop := CR.Bottom-Cr.Top-35;
  346.   for Indx := 1  to 4 do
  347.       if BNR[Indx] <> nil then
  348.         begin
  349.         MoveWindow(BNR[Indx]^.HWindow,35*Pred(Indx),NewTop,35,35,False);
  350.       MoveWindow(GB2^.HWindow,0,NewTOP,35*(Indx),35,False);
  351.       end;
  352.     For Indx := 1 to 20 do
  353.         SendMessage(RB[Indx]^.HWindow,WM_SETFONT,TheFont,0);
  354.   SendMessage(GB1^.HWindow,WM_SETFONT,TheFont,0);
  355.   St1^.SetFont(TheFont);
  356.   St2^.SetFont(TheFont);
  357.     GetPrivateProfileString('OM','PgmFile99','OMLOGO.BMP',Buf,SizeOf(Buf),IniFile);
  358.   Bitmap:= New(PTBMP,Init('xx'));
  359.   if StrLen(Buf) <> 0 then
  360.       Bitmap^.LoadBitmapFile(buf);
  361.   Pict := Bitmap^.DDB;
  362.   Logo := LoadBitmap(HInstance,'OM_Logo');
  363.   if Pict = 0 then
  364.       Pict := Logo;
  365.   MakeRect(5,75,185,CR.Bottom-40,@MPR);
  366.   GetPictRect;
  367.     SetStaticText;
  368.   SetRBText;
  369.   DragAcceptFiles(HWindow,TRUE);
  370.   SetTimer(HWindow,id_Timer,30000,nil);
  371. end;
  372.  
  373. procedure TOMWindow.SetStaticText;
  374. var
  375.   Buf,Buf1:Array[0..55] of Char;
  376.   Mem :Record
  377.       GlobalFreeMem,User,GDI:LongInt;
  378.   end;
  379.   Res:Record
  380.       HRes,VRes,NColors:Integer;
  381.   end;
  382.   PageNumBuf:Array[0..25] of Char;
  383.   nBitsPixel,nPlanes,nSizePalette:Integer;
  384.   DC:HDc;
  385.   R:TRect;
  386.   Item:PPgmItem;
  387. begin
  388. if StatDisp = 'M' then
  389.     begin
  390.     Mem.GlobalFreeMem := Round(GetFreeSpace(0) / 1024);
  391.   Mem.GDI := GetFreeSystemResources(1);
  392.   Mem.User := GetFreeSystemResources(2);
  393.   wvsprintf(Buf,'GMem:%luK  User:%lu%%  GDI:%li%%',Mem);
  394.   end
  395. else
  396.     begin
  397.   Res.HRes := GetSystemMetrics(sm_CXScreen);
  398.   Res.VRes := GetSystemMetrics(sm_CYScreen);
  399.   DC := GetDC(HWindow);
  400.   nPlanes := GetDeviceCaps(DC,Planes);
  401.   nBitsPixel := GetDeviceCaps(DC,BitsPixel);
  402.   nSizePalette := GetDeviceCaps(DC,SizePalette);
  403.   if (RC_Palette AND GetDeviceCaps(DC,RASTERCAPS)) > 0 then
  404.       Res.NColors := nSizePalette
  405.   else
  406.          Res.NColors := (nPlanes * nBitsPixel) shl 2 ;
  407.   ReleaseDC(HWindow,DC);
  408.   wvsprintf(Buf,'HRes:%i  VRes:%i  #Colors:%i',Res);
  409.     end;
  410.   St1^.SetText(Buf);
  411.   GetWindowText(GB1^.HWindow,Buf1,sizeof(Buf1));
  412.   Str(PageNum,PageNumBuf);
  413.   StrCat(StrCopy(Buf,'Page: '),PageNumBuf);
  414.   Item :=Apps^.At(PageNum+100);
  415.     if Item^.PgmName <> nil then
  416.       StrCopy(Buf,Item^.PgmName);
  417.   if StrIComp(Buf,Buf1) <> 0 then
  418.        St2^.SetText(Buf);
  419. end;
  420.  
  421. procedure TOMWindow.SetRBText;
  422. var
  423.     Offset:Integer;
  424.     ChildWin:PRadioButton;
  425.   Indx:Integer;
  426.   Item:PPgmItem;
  427. begin
  428.     Offset := Pred(PageNum)*20;
  429.     For Indx := Offset+1 to Offset+20 do
  430.       begin
  431.     Item := Apps^.At(Indx);
  432.     SetWindowText(RB[Indx-OffSet]^.HWindow,Item^.PgmName);
  433.       end;
  434. end;
  435.  
  436. destructor TOMWindow.Done;
  437. begin
  438.     KillTimer(HWindow,id_Timer);
  439.     Dispose(Bitmap,Done);
  440.     DeleteObject(TheFont);
  441.   Dispose(Apps,Done);
  442.   if Logo <> 0 then DeleteObject(Logo);
  443.     if BkBrush <> 0 then DeleteObject(BkBrush);
  444.   DragAcceptFiles(HWindow,FALSE);
  445.   TWindow.Done;
  446. end;
  447.  
  448. procedure TOMWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  449. const
  450.     X1=190; Y1=48; X2=560; Y2=290;
  451. var
  452.     ThePen,OldPen:HPen;
  453.   TheBrush,OldBrush:HBrush;
  454.   MemDC:hDC;
  455.   CR:TRect;
  456. begin
  457.     TheBrush := GetStockObject(LtGray_Brush);
  458.     ThePen := CreatePen(ps_Solid,1,$00000000);
  459.   OldPen := SelectObject(PaintDC,ThePen);
  460.   OldBrush := SelectObject(PaintDC,TheBrush);
  461.   GetClientRect(HWindow,CR);
  462.   Rectangle(PaintDC,0,0,CR.Right-CR.Left,35);
  463.   SelectObject(PaintDC,OldBrush);
  464.   SelectObject(PaintDC,OldPen);
  465.   DeleteObject(ThePen);
  466.   DeleteObject(TheBrush);
  467.   SRectangle(PaintDC,X1,Y1,X2,Y2,2,sr_Recessed);
  468.     Bitmap^.Draw(PaintDC,PictRect,False);
  469. end;
  470.  
  471. procedure    TOMWindow.WMDrawItem(var Msg:TMessage);
  472. var
  473.     PDIS : ^TDrawItemStruct;
  474. begin
  475.     PDIS := Pointer(Msg.lParam);
  476.     case PDIS^.CtlType of
  477.         odt_Button:
  478.         case PDIS^.CtlID of
  479.             id_But1..id_But10:Bn1[PDIS^.CtlID-200]^.DrawItem(Msg);
  480.             id_But11..id_But15:Bn2[PDIS^.CtlID-210]^.DrawItem(Msg);
  481.             id_But21..id_But24:BnR[PDIS^.CtlID-220]^.DrawItem(Msg);
  482.         end;
  483.     end;
  484. end;
  485.  
  486. procedure TOMWindow.IDBut11(var Msg:TMessage);
  487. var
  488.     Item:PPgmItem;
  489. begin
  490.     Item := Apps^.At(91);
  491.     if (Item^.Dir <> NIL) then
  492.           SetCurdir(Item^.Dir);
  493.   if (Item^.PgmFile <> nil) then
  494.       WinExec(Item^.PgmFile,sw_Normal)
  495.   else
  496.         WinExec('command.com',sw_Normal);
  497. end;
  498.  
  499. procedure TOMWindow.IDBut12(var Msg:TMessage);
  500. begin
  501.     Runit;
  502. end;
  503.  
  504. procedure TOMWindow.IDBut13(var Msg:TMessage);
  505. var
  506.     Dlg3:POMDlg3;
  507. begin
  508.     Dlg3 := New(POMDlg3,Init(@Self,'Om_Dlg3'));
  509.     Application^.ExecDialog(Dlg3);
  510. end;
  511.  
  512. procedure TOMWindow.IDBut14(var Msg:TMessage);
  513. var
  514.     FCWin:PFCWindow;
  515. begin
  516.     FCWin := New(PFCWindow,Init(@Self,'OM File'));
  517.   Application^.MakeWindow(FCWin);
  518.  
  519. end;
  520.  
  521. procedure TOMWindow.IDBut15(var Msg:TMessage);
  522. begin
  523.   ExitWindows(0,0);
  524. end;
  525.  
  526. procedure TOMWindow.DefChildProc(var Msg:TMessage);
  527. var
  528.     ID:Integer;
  529. begin
  530.   case Msg.WParam of
  531.       id_But1..id_But10:
  532.       WinExecc(Msg);
  533.     Succ(id_GB1)..id_GB1+20:
  534.       WinExecc(Msg);
  535.     id_But21..id_But24:
  536.             begin
  537.             PageNum := Msg.wParam-220;
  538.           SetRBText;
  539.           SetStaticText;
  540.             end;
  541.     else
  542.         TWindow.DefChildProc(Msg);
  543.     end;
  544. end;
  545.  
  546. procedure TOMWindow.WinExecc(var Msg:TMessage);
  547. var
  548.     Indx:Integer;
  549.     Item:PPgmItem;
  550.   Buf:Array[0..100] of Char;
  551.   Errval:Integer;
  552.   nCmdShow,CmdShow:Integer;
  553. begin
  554.     Indx := CtrlToIndx(Msg.wParam);
  555.     Item := Apps^.At(Indx);
  556.   if (Item^.PgmFile = NIL) then
  557.       begin
  558.       if (Msg.wParam > id_Gb1) then
  559.           RB[Msg.WParam-id_GB1]^.Toggle;
  560.     TWindow.DefChildProc(Msg);
  561.     Exit;
  562.     end;
  563.   StrCopy(Buf,Item^.PgmFile);
  564.   if (Item^.Params <> NIL) then
  565.           StrCat(StrCat(Buf,' '),Item^.Params);
  566.   if (Item^.Cmdshow <> NIL) then
  567.       case Item^.CmdShow[0] of
  568.         'N','n':Cmdshow := sw_Normal;
  569.       'M','m':CmdShow := sw_Maximize;
  570.       'I','i':CmdShow := sw_Minimize;
  571.         else
  572.           CmdShow := sw_Normal;
  573.     end
  574.   else
  575.       CmdShow := sw_Normal;
  576.     if (Item^.Dir <> NIL) then
  577.       SetCurdir(Item^.Dir);
  578.   WinExec(Buf,CmdShow);
  579.   if Msg.wParam > id_GB1 then
  580.         RB[Msg.WParam-id_GB1]^.Toggle;
  581.   If AutoMin = 1 then
  582.       ShowWindow(HWindow,sw_Minimize);
  583. end;
  584.  
  585. procedure    TOMWindow.WMSysCommand(var Msg:TMessage);
  586. begin
  587.     case Msg.Wparam of
  588.         idm_About:
  589.              Application^.ExecDialog(New(POMAboutDlg,Init(@Self,'OM_About',Logo)));
  590.        else
  591.            DefWndProc(Msg);
  592.        end;
  593. end;
  594.  
  595. procedure TOMWindow.SetItemValues(PgmItem:ItemRec);
  596. begin
  597.     Apps^.ItemSet(PgmItem);
  598.   SetRBText;
  599. end;
  600.  
  601. procedure TOMWindow.WMCTLCOLOR(var Msg: TMessage);
  602. begin
  603.   case Msg.LParamHi of
  604.     ctlcolor_Btn:
  605.       begin
  606.       SetBkMode(Msg.WParam, Transparent);
  607.       Msg.Result := GetStockObject(ltGray_Brush);
  608.       end;
  609.   else
  610.     DefWndProc(Msg);
  611.   end;
  612. end;
  613.  
  614. procedure TOMWindow.Runit;
  615. const
  616.   szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  617. var
  618.   Path,Name,Ext,OldDir:Array[0..fsPathName] of Char;
  619.     szDirName:Array[0..256] of Char;
  620.   szFile,szFileTitle:Array[0..256] of Char;
  621.   OFN:TOpenFileName;
  622. begin
  623.     StrCopy(szFile,'');
  624.   OFN.lStructSize := sizeof(TOpenFileName);
  625.   OFN.hWndOwner := HWindow;
  626.   OFN.lpStrFilter := @szFilter;
  627.   OFN.lpStrCustomFilter := nil;
  628.   OFN.nMaxCustFilter := 0;
  629.   OFN.nFilterIndex := LongInt(1);
  630.   OFN.lpStrFile := szFile;
  631.   OFN.nMaxFile := sizeof(szFile);
  632.   OFN.lpstrfileTitle := szFileTitle;
  633.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  634.   OFN.lpstrInitialDir := NIL;
  635.   OFN.lpStrTitle := 'Run A Program';
  636.   OFN.flags := 0;
  637.   OFN.nFileOffset := 0;
  638.   OFN.nFileExtension := 0;
  639.   OFN.lpstrDefext := nil;
  640.   If GetOpenFileName(OFN) then
  641.       begin
  642.     filesplit(szFile,Path,Name,Ext);
  643.     SetCurDir(Path);
  644.       WinExec(Name,sw_Normal);
  645.     SetCurdir(OldDir);
  646.       If AutoMin = 1 then
  647.           ShowWindow(HWindow,sw_Minimize);
  648.     end;
  649. end;
  650.  
  651. procedure TOMWindow.UMDropFiles(var Msg:TMessage);
  652. var
  653.     FileNamePtr:PChar;
  654.   CtrlID:Integer;
  655.     Buf1:Array[0..30] of Char;
  656.   Indx:Integer;
  657.     PgmItem:ItemRec;
  658.   Dir,Name,Ext:Array[0..fsPathName] of Char;
  659. begin
  660.     FileNamePtr := Pointer(Msg.lParam);
  661.   FileSplit(FileNamePtr,Dir,Name,Ext);
  662.   AnsiLower(Name);
  663.   Name[0] := UpCase(Name[0]);
  664.     StrCopy(PgmItem.PgmName,Name);
  665.   StrCopy(PgmItem.PgmFile,FileNamePtr);
  666.   CtrlID :=Msg.wParam;
  667.   If CtrlID = id_Pict then
  668.       Indx := id_BMP
  669.   else
  670.         Indx := CtrlToIndx(Msg.wParam);
  671.   Str(Indx:2,PgmItem.ItemNum);
  672.   StrCopy(PgmItem.Dir,'');
  673.   StrCopy(PgmItem.Params,'');
  674.   StrCopy(PgmItem.CmdShow,'N');
  675.   SetItemValues(PgmItem);
  676. end;
  677.  
  678. procedure TOMWindow.UMRButtonDown(var Msg:TMessage);
  679. begin
  680.   if Msg.wParam = id_St1 then
  681.       SetStatProp(Msg)
  682.   else if (Msg.wParam > id_But11) and (Msg.wParam < Succ(id_But15)) then
  683.   else if (Msg.wParam = id_RGB) then
  684.       SetRGBProp(Msg)
  685.   else if (Msg.wParam = id_Pict) then
  686.       SetBMPProp(Msg)
  687.   else if (Msg.wParam > id_GB2) and (Msg.wParam < id_GB1+100) then
  688.       SetButProp(Msg)
  689.   else
  690.       DefWndProc(Msg);
  691. end;
  692.  
  693. function TOMWindow.CtrlToIndx(ID:Integer):Integer;
  694. begin
  695.     if ID > id_GB1 then
  696.         CtrlToIndx := ID - id_GB1 + (20*Pred(PageNum))
  697.   else
  698.         CtrlToIndx := ID - id_GB2 + 80;
  699. end;
  700.  
  701. procedure TOMWindow.WMRButtonDown(var Msg:TMessage);
  702. begin
  703.      if PtInRect(PictRect,MakePoint(Msg.lParam))  then
  704.       SendMessage(HWindow,wm_User+wm_RButtonDown,id_Pict,Msg.lParam)
  705.   else
  706.       SendMessage(HWindow,wm_User+wm_RButtonDown,id_RGB,Msg.lParam);
  707.     DefWndProc(Msg);
  708. end;
  709.  
  710. procedure TOMWindow.SetStatProp(var Msg:TMessage);
  711. begin
  712.     if StatDisp = 'M' then
  713.     StatDisp := 'R'
  714.   else
  715.         StatDisp := 'M';
  716.   WritePrivateProfileString('OM','StatDisp',@StatDisp,IniFile);
  717.   SetStaticText;
  718. end;
  719.  
  720. procedure TOMWindow.SetButProp(var Msg:TMessage);
  721. var
  722.   Dlg2:POMDlg2;
  723. begin
  724.   FillChar(D2TfB,sizeof(D2TfB),$0);
  725.     Dlg2 := New(POMDlg2,Init(@Self,'Om_Dlg2'));
  726.   Str(CtrlToIndx(Msg.wParam),D2TfB.ItemNum);
  727.   Dlg2^.TransferBuffer := @D2TfB;
  728.   Apps^.ItemGet(D2TfB);
  729.     if StrLen(D2TfB.Cmdshow) = 0 then
  730.       StrCopy(D2TfB.Cmdshow,'N');
  731.   if (Application^.ExecDialog(Dlg2) = 1) then
  732.       begin
  733.     SetItemValues(D2TfB);
  734.       if (Msg.wParam > id_But0) and (Msg.wParam < id_But11) then
  735.           BN1[Msg.wParam - id_But0]^.ChangeBMP(D2TfB.PgmFile)
  736.     else if (Msg.wParam >id_But15) and (Msg.wParam < id_But24+1) then
  737.         begin
  738.       if StrLen(D2TfB.PgmFile)> 0 then
  739.           BNR[Msg.wParam - 220]^.ChangeBMP(D2TfB.PgmFile);
  740.       SetStaticText;
  741.       end;
  742.       end;
  743. end;
  744.  
  745. procedure TOMWindow.SetBMPProp(var Msg:TMessage);
  746. var
  747.   Dlg2:POMDlg2;
  748. begin
  749.   FillChar(D2TfB,sizeof(D2TfB),$0);
  750.     Dlg2 := New(POMDlg2,Init(@Self,'Om_Dlg2'));
  751.   StrCopy(D2TfB.ItemNum,'99');
  752.   Dlg2^.TransferBuffer := @D2TfB;
  753.   Apps^.ItemGet(D2TfB);
  754.   StrCopy(D2TfB.Cmdshow,'N');
  755.   if (Application^.ExecDialog(Dlg2) = 1) then
  756.       begin
  757.     SetItemValues(D2TfB);
  758.       if  (StrLen(D2TfB.PgmFile) <> 0) then
  759.           LoadBMP(D2TfB.PgmFile);
  760.       end;
  761. end;
  762.  
  763. procedure TOMWindow.SetRGBProp(var Msg:TMessage);
  764. var
  765.     Chsclr:TChooseColor;
  766.   Color:LongInt;
  767.   ColorArray:Array[0..15] of LongInt;
  768.   Indx:Integer;
  769.   BkColor:Array[0..12] of Char;
  770.   Buf:Array[0..15] of Char;
  771.   Errornum:Integer;
  772. begin
  773.       begin
  774.       for Indx := 0 to 15 do ColorArray[Indx] := LongInt(RGB(255,255,255));
  775.         GetPrivateProfileString('OM','BkgndColor','12632256',Buf,SizeOf(Buf),IniFile);
  776.     Val(Buf,Color,Errornum);
  777.       ChsClr.lStructsize:= sizeof(TChooseColor);
  778.       ChsClr.hWndOwner := HWindow;
  779.       ChsClr.hInstance := HInstance;
  780.       ChsClr.rgbResult := Color;
  781.        ChsClr.lpcustcolors := pLongInt(@ColorArray);
  782.       ChsClr.lcustdata := 0;
  783.       ChsClr.Flags :=  cc_RGBInit;
  784.       ChsClr.lptemplateName := PChar(nil);
  785.         if Choosecolor(ChsClr) then
  786.         begin
  787.         Str(ChsClr.rgbResult,BkColor);
  788.         WritePrivateProfileString('OM','BkgndColor',BkColor,IniFile);
  789.       CreateBrush(BkColor);
  790.       end;
  791.     end;
  792. end;
  793.  
  794. procedure TOMWindow.WMDropFiles(var Msg:TMessage);
  795. var
  796.     DropItem:hDrop;
  797.   FileNameBuf:Array[0..fsPathName] of Char;
  798.   GFileName:PChar;
  799.   Loc:TPoint;
  800. begin
  801.     DropItem := Msg.wParam;
  802.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  803.   DragQueryPoint(DropItem,Loc);
  804.   DragFinish(DropItem);
  805.      if PtInRect(PictRect,Loc) then
  806.        begin
  807.       GFileName :=StrNew(FileNameBuf);
  808.       SendMessage(HWindow,wm_User+wm_DropFiles,id_Pict,LongInt(GFileName));
  809.     StrDispose(GFileName);
  810.     LoadBMP(FileNameBuf);
  811.       end;
  812. end;
  813.  
  814. procedure TOMWindow.LoadBMP(BMPName:PChar);
  815. begin
  816.     Dispose(BitMap,Done);
  817.   Bitmap:= New(PTBMP,Init('xx'));
  818.   Bitmap^.LoadBitmapFile(BMPName);
  819.   Pict := Bitmap^.DDB;
  820.   GetPictRect;
  821.   InvalidateRect(HWindow,nil,True);
  822.   UpdateWindow(HWindow);
  823. end;
  824.  
  825. procedure TOMWindow.GetPictRect;
  826. var
  827.     CR:TRect;
  828.   PictMetrics:TBitmap;
  829.   dW,dH:Integer;
  830. begin
  831.     GetClientRect(HWindow,CR);
  832.   GetObject(Pict,SizeOf(PictMetrics),@PictMetrics);
  833.   dW:=(MPR.Right-MPR.Left-PictMetrics.bmWidth) div 2;
  834.   dH := (MPR.Bottom-MPR.Top-PictMetrics.bmHeight) div 2;
  835.   PictRect.Left := Max(MPR.Left +dW , MPR.Left);
  836.   PictRect.Top := Max(MPR.Top+dH, MPR.Top);
  837.   PictRect.Right := Min(MPR.Right-dW,MPR.Right);
  838.   PictRect.Bottom := Min(MPR.Bottom-dH,MPR.Bottom);
  839. end;
  840.  
  841. procedure TOMWindow.CreateBrush(BkgndColor:PChar);
  842. var
  843.     DC,MemDC:HDC;
  844.   NewBmp,Bmp,OldBmp:HBitmap;
  845.   NewBrush,OldBrush,MonoBrush:HBrush;
  846.   nBkgndColor:TColorRef;
  847.   ErrCode:Integer;
  848.   BkgndBr:HBrush;
  849. begin
  850.   If BkBrush > 0 then
  851.       DeleteObject(BkBrush);
  852.   Val(BkgndColor,nBkgndColor,ErrCode);
  853.   Bmp :=LoadBitmap(HInstance,'OM_Br');
  854.   MonoBrush :=CreatePatternBrush(Bmp);
  855.     DC := GetDC(HWindow);
  856.   NewBMP := CreateCompatibleBitmap(DC,8,8);
  857.   MemDC := CreateCompatibleDC(DC);
  858.   SetTextColor(MemDC,nBkgndColor);
  859.   OldBrush := SelectObject(MemDC,MonoBrush);
  860.   OldBmp := SelectObject(MemDC,NewBmp);
  861.     PatBlt(MemDC,0,0,8,8,PatCopy);
  862.   SelectObject(MemDC,OldBmp);
  863.   SelectObject(MemDC,OldBrush);
  864.   DeleteObject(MonoBrush);
  865.   BkBrush := CreatePatternBrush(NewBMP);
  866.   DeleteObject(Bmp);
  867.   DeleteObject(NewBmp);
  868.   DeleteDC(MemDC);
  869.   ReleaseDC(HWindow,DC);
  870.   InvalidateRect(HWindow,nil,True);
  871. end;
  872.  
  873. procedure TOMWindow.WMNCRButtonDown(var Msg:TMessage);
  874. var
  875.     TheDialog:POMDlg1;
  876.     RadioRec :Record
  877.       RB1,RB2:Bool;
  878.   end;
  879.   RBut1,RBut2:PRadioButton;
  880.   FontBut:PButton;
  881. begin
  882.     TheDialog :=New(POmDlg1,Init(@Self,'OM_DLG1'));
  883.   New(RBut1,InitResource(TheDialog,id_D1RB1));
  884.   New(RBut2,InitResource(TheDialog,id_D1RB2));
  885.   New(FontBut,InitResource(TheDialog,id_D1SetFont));
  886.   RadioRec.RB1 := False;
  887.   RadioRec.RB2 := True;
  888.   TheDialog^.TransferBuffer := @RadioRec;
  889.   Application^.ExecDialog(TheDialog);
  890.   If RadioRec.RB1 then
  891.       begin
  892.     AutoMin := 1;
  893.     WritePrivateProfileString('OM','AutoMin','1',IniFile);
  894.     end
  895.   else
  896.       begin
  897.     AutoMin := 0;
  898.     WritePrivateProfileString('OM','AutoMin','0',IniFile);
  899.     end;
  900. end;
  901.  
  902. procedure TOMWindow.WMEraseBkGnd(var Msg:TMessage);
  903. var
  904.     Rect:TRect;
  905.   OldBrush:HBrush;
  906. begin
  907.     if BkBrush = 0 then
  908.   else
  909.       begin
  910.         UnrealizeObject(BkBrush);
  911.       OldBrush := SelectObject(Msg.WParam, BkBrush);
  912.       GetClientRect(HWindow, Rect);
  913.       PatBlt(Msg.wParam, Rect.left, Rect.top, Rect.right-Rect.left,
  914.               Rect.Bottom - Rect.Top, PATCOPY);
  915.       SelectObject(Msg.wParam, OldBrush);
  916.       end;
  917. end;
  918.  
  919. procedure TOMWindow.WMTimer(var Msg:TMessage);
  920. begin
  921.     if Msg.wParam = id_Timer then
  922.         SetStaticText;
  923. end;
  924.  
  925. procedure TOMWindow.UMSetFont(var Msg:TMessage);
  926. var
  927.     CF:TChooseFont;
  928.   DC:HDC;
  929.     Buf:Array[0..5] of Char;
  930.   Bufl:Array[0..65] of Char;
  931. begin
  932.   DC := GetDC(HWindow);
  933.   with CF do
  934.       begin
  935.     lStructSize := sizeof(TChooseFont);
  936.     hDC := DC;
  937.     hWndOwner := HWindow;
  938.     lpLogfont:= @LogFont;
  939.     iPointSize := FontSize    ;  {in tenths of a point}
  940.     Flags := CF_ScreenFonts or CF_EFFECTS or CF_INITTOLOGFONTSTRUCT;
  941.     rgbColors:=RGB(255,0,0);
  942.     lCustData := 0;
  943.     @lpfnHook:= Pointer(0);
  944.     end;
  945.   if ChooseFont(CF) then
  946.       begin
  947.       ReleaseDC(HWindow,DC);
  948.       FontSize := CF.iPointSize;
  949.     DeleteObject(TheFont);
  950.       TheFont := CreateFontIndirect(LogFont);
  951.     SetStaticText;
  952.     with LogFont do
  953.           begin
  954.         Str(lfHeight,Buf);
  955.         WritePrivateProfileString('OM','lfHeight',Buf,IniFile);
  956.         Str(lfWidth,Buf);
  957.         WritePrivateProfileString('OM','lfWidth',Buf,IniFile);
  958.         Str(lfEscapement,Buf);
  959.         WritePrivateProfileString('OM','lfEscapement',Buf,IniFile);
  960.         Str(lfOrientation,Buf);
  961.         WritePrivateProfileString('OM','lfOrientation',Buf,IniFile);
  962.         Str(lfWeight,Buf);
  963.         WritePrivateProfileString('OM','lfWeight',Buf,IniFile);
  964.         Str(lfItalic,Buf);
  965.         WritePrivateProfileString('OM','lfItalic',Buf,IniFile);
  966.         Str(lfUnderline,Buf);
  967.         WritePrivateProfileString('OM','lfUnderline',Buf,IniFile);
  968.         Str(lfStrikeout,Buf);
  969.         WritePrivateProfileString('OM','lfStrikeout',Buf,IniFile);
  970.         Str(lfCharSet,Buf);
  971.         WritePrivateProfileString('OM','lfCharSet',Buf,IniFile);
  972.         Str(lfOutPrecision,Buf);
  973.         WritePrivateProfileString('OM','lfOutPrecision',Buf,IniFile);
  974.         Str(lfClipPrecision,Buf);
  975.         WritePrivateProfileString('OM','lfClipPrecision',Buf,IniFile);
  976.         Str(lfQuality,Buf);
  977.         WritePrivateProfileString('OM','lfQuality',Buf,IniFile);
  978.         Str(lfPitchAndFamily,Buf);
  979.         WritePrivateProfileString('OM','lfPitchAndFamily',Buf,IniFile);
  980.         WritePrivateProfileString('OM','lfFaceName',lfFaceName,IniFile);
  981.         Str(FontSize,Buf);
  982.         WritePrivateProfileString('OM','Fontsize',Buf,IniFile);
  983.       end;
  984.       SetRBText;
  985.     end
  986.   else
  987.       ReleaseDC(HWindow,DC);
  988. end;
  989. {************************  TOMDlg1  *****************************}
  990. procedure TOMDlg1.IDSetFont(var Msg:TMessage);
  991. begin
  992.     SendMessage(Parent^.HWindow,WM_USER+ID_D1SETFONT,0,0);
  993. end;
  994. {***********************  TOMDlg2  ******************************}
  995. constructor TOMDlg2.Init(AParent:PWindowsObject;AName:PChar);
  996. begin
  997.     TDialog.Init(AParent,AName);
  998.   New(EC1,InitResource(@Self,id_D2Ec1,70));
  999.   New(EC2,InitResource(@Self,id_D2Ec2,70));
  1000.   New(EC3,InitResource(@Self,id_D2Ec3,70));
  1001.   New(EC4,InitResource(@Self,id_D2Ec4,70));
  1002.   New(EC5,InitResource(@Self,id_D2Ec5,70));
  1003.   New(EC6,InitResource(@Self,id_D2Ec6,70));
  1004. end;
  1005.  
  1006. procedure TOMDlg2.IDD2OK(var Msg:TMessage);
  1007. begin
  1008.     TransferData(tf_GetData);
  1009.   EndDlg(1);
  1010. end;
  1011.  
  1012. procedure TOMDlg2.IDBrowse(var Msg:TMessage);
  1013. const
  1014.   szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  1015. var
  1016.   pBuf:PChar;
  1017.   Dir,Name,Ext:Array[0..fsPathName] of Char;
  1018.     szDirName:Array[0..256] of Char;
  1019.   szFile,szFileTitle:Array[0..256] of Char;
  1020.   OFN:TOpenFileName;
  1021.   Ptr:PChar;
  1022. begin
  1023.     Ptr := @szFilter;
  1024.     StrCopy(szFile,'');
  1025.   OFN.lStructSize := sizeof(TOpenFileName);
  1026.   OFN.hWndOwner := HWindow;
  1027.   OFN.lpStrFilter := Ptr;
  1028.   OFN.lpStrCustomFilter := nil;
  1029.   OFN.nMaxCustFilter := 0;
  1030.   OFN.nFilterIndex := LongInt(1);
  1031.   OFN.lpStrFile := szFile;
  1032.   OFN.nMaxFile := sizeof(szFile);
  1033.   OFN.lpstrfileTitle := szFileTitle;
  1034.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  1035.   OFN.lpstrInitialDir := NIL;
  1036.   OFN.lpStrTitle := 'Select Program';
  1037.   OFN.flags := OFN_Pathmustexist or OFN_Filemustexist;
  1038.   OFN.nFileOffset := 0;
  1039.   OFN.nFileExtension := 0;
  1040.   OFN.lpstrDefext := nil;
  1041.   If GetOpenFileName(OFN) then
  1042.       begin
  1043.     FileSplit(szFile,Dir,Name,Ext);
  1044.     StrLower(Name);
  1045.     Name[0] := UpCase(Name[0]);
  1046.     pBuf := Name;
  1047.     EC2^.SetText(pBuf);
  1048.     pBuf := szFile;
  1049.       EC3^.SetText(pBuf);
  1050.     SetFocus(GetItemHandle(id_D2Ec4));
  1051.     end;
  1052. end;
  1053. {***********************  TOMDlg3  ******************************}
  1054. procedure TOMDlg3.SetupWindow;
  1055. var
  1056.     ArgList : record
  1057.         StrPtr : PChar;
  1058.       Free:PChar;
  1059.       Size:LongInt;
  1060.       PctFree:LongInt;
  1061.     end;
  1062.     szFree:Array[0..5] of Char;
  1063.   rFree:Real;
  1064.   szDr:Array[0..2] of Char;
  1065.   szOutput : Array[0..80] of Char;
  1066.   hListBox:hWnd;
  1067. begin
  1068.     TDialog.SetupWindow;
  1069.     hListBox :=GetItemHandle(Id_D3Lb1);
  1070.     SendMessage(hListBox,wm_SetFont,GetStockObject(OEM_Fixed_Font),0);
  1071.     DosError := 0; StrCopy(szOutput,'');
  1072.   WVSPrintf(szOutput,'Dr  MBf  MBt %%Free',ArgList);
  1073.   SendMessage(hListBox,lb_AddString,0,LongInt(@szOutput));
  1074.  
  1075.   StrCopy(szDr,'C:');
  1076.   while DosError = 0 do
  1077.        begin
  1078.     SetCurDir(szDr);
  1079.       if DosError = 0 then
  1080.           begin
  1081.         rFree := (DiskFree(0) / 1024 / 1024);
  1082.         Str(rFree:4:1,szFree);
  1083.         ArgList.Free := @szFree;
  1084.         ArgList.Size := Round( DiskSize(0) / 1024 /1024) ;
  1085.         ArgList.PctFree := Round(DiskFree(0) / (DiskSize(0) / 100 )) ;
  1086.         ArgList.StrPtr := @szDr;
  1087.         WVSPrintf(szOutput,'%s %s  %3li  %3li',ArgList);
  1088.         SendMessage(hListBox,lb_AddString,0,LongInt(@szOutput));
  1089.         end;
  1090.         Inc(szDr[0]);
  1091.     end;
  1092. end;
  1093. {********************  TOMAbout     **************************}
  1094. constructor TOMAboutDlg.Init(AParent:PWindowsObject;AName:PChar;ALogo:HBitmap);
  1095. begin
  1096.     TDialog.Init(AParent,AName);
  1097.   Logo := ALogo;
  1098. end;
  1099.  
  1100. procedure TOMAboutDlg.WMCTLCOLOR(var Msg: TMessage);
  1101. const
  1102.   as_AboutSt1 =   126;  {about dlg static text   }
  1103.   as_AboutSt2 =   128;  {about dlg static blank static to draw upon}
  1104. var
  1105.     HSt1,HSt2:HWnd;
  1106.   MemDC:hDC;
  1107.   OldBitmap:HBitmap;
  1108.   CR:TRect;
  1109.   X,Y,W,H:Integer;
  1110.   LogoMetrics:TBitmap;
  1111. begin
  1112.   case Msg.LParamHi of
  1113.     ctlColor_Static:
  1114.       begin
  1115.         If (as_AboutSt1 = GetDlgCtrlID(Msg.lParamLo)) then
  1116.             SetTextColor(Msg.WParam, RGB(0,0,255))
  1117.         else  if (as_AboutSt2 = GetDlgCtrlID(Msg.lParamLo)) then
  1118.             begin
  1119.           MemDC := CreateCompatibleDC(Msg.WParam);
  1120.           OldBitmap := SelectObject(MemDC,Logo);
  1121.           GetClientRect(Msg.lParamLo,CR);
  1122.           W:= CR.Right-CR.Left;H:= CR.Bottom-CR.Top;
  1123.           GetObject(Logo,SizeOf(LogoMetrics),@LogoMetrics);
  1124.           X := Max((W - LogoMetrics.bmWidth) div 2 , 0);
  1125.           Y := Max((H - LogoMetrics.bmHeight) div 2 , 0);
  1126.           BitBlt(Msg.WParam,X,Y,W,H,MemDc,0,0,SrcCopy);
  1127.           SelectObject(MemDC,OldBitmap);
  1128.           DeleteDC(MemDc);
  1129.           end;
  1130.         SetBkMode(Msg.WParam, transparent);
  1131.         Msg.Result := GetStockObject(Null_Brush);
  1132.       end;
  1133.     ctlcolor_Dlg:
  1134.       begin
  1135.         SetBkMode(Msg.WParam, Transparent);
  1136.         Msg.Result := GetStockObject(ltGray_Brush);
  1137.       end;
  1138.   else
  1139.     DefWndProc(Msg);
  1140.   end;
  1141. end;
  1142. {************************  TPrgItem    *****************************}
  1143. constructor TPgmItem.Init(NewPgmName,NewPgmFile,NewDir,NewParams:PChar;NewCmdShow:Pchar);
  1144. begin
  1145.     PgmName := StrNew(NewPgmName);
  1146.   PgmFile := StrNew(NewPgmFile);
  1147.   Dir := StrNew(NewDir);
  1148.   Params := StrNew(NewParams);
  1149.   CmdShow := StrNew(NewCmdShow);
  1150. end;
  1151.  
  1152. destructor TPgmItem.Done;
  1153. begin
  1154.     StrDispose(PgmName);
  1155.   StrDispose(PgmFile);
  1156.   StrDispose(Dir);
  1157.   StrDispose(Params);
  1158.   StrDispose(CmdShow);
  1159. end;
  1160. {************************  TOMCol    *****************************}
  1161. constructor TOMCol.Init(ALimit,ADelta:Integer;NewIniFile:Pchar);
  1162. begin
  1163.     TheItems := New(PCollection,Init(ALimit,ADelta));
  1164.   StrCopy(IniFile,NewIniFile);
  1165. end;
  1166.  
  1167. destructor TOMCol.Done;
  1168. begin
  1169.     Dispose(TheItems,Done);
  1170. end;
  1171.  
  1172. function TOMCol.At(Indx:Integer):PPgmItem;
  1173. begin
  1174.     At := TheItems^.At(Indx);
  1175. end;
  1176.  
  1177. procedure TOMCol.ReadItems(Start,Finish:Integer);
  1178. var
  1179.     Buf1:Array[0..30] of Char;
  1180.   Indx:Integer;
  1181.   IndxStr:Array[0..5] of Char;
  1182.   Found:Boolean;
  1183.   Key:Array[0..20] of Char;
  1184.   PgmName,PgmFile,Dir,Params:Array[0..50] of Char;
  1185.   CmdShow:Array[0..5] of Char;
  1186. begin
  1187.   for Indx := Start to Finish do
  1188.       begin
  1189.     StrCopy(PgmFile,'');Strcopy(Dir,'');StrCopy(Params,'');StrCopy(CmdShow,'');
  1190.     Str(Indx,IndxStr);
  1191.     StrCat(StrCopy(Key,'PgmName'),IndxStr);
  1192.         GetPrivateProfileString('OM',Key,'',PgmName,SizeOf(PgmName),IniFile);
  1193.     if PgmName[0] <> #0 then
  1194.         begin
  1195.         StrCat(StrCopy(Key,'PgmFile'),IndxStr);
  1196.             GetPrivateProfileString('OM',Key,'',PgmFile,SizeOf(PgmFile),IniFile);
  1197.         StrCat(StrCopy(Key,'Dir'),IndxStr);
  1198.             GetPrivateProfileString('OM',Key,'',Dir,SizeOf(dir),IniFile);
  1199.         StrCat(StrCopy(Key,'Params'),IndxStr);
  1200.             GetPrivateProfileString('OM',Key,'',Params,SizeOf(Params),IniFile);
  1201.         StrCat(StrCopy(Key,'CmdShow'),IndxStr);
  1202.             GetPrivateProfileString('OM',Key,'',Cmdshow,SizeOf(CmdShow),IniFile);
  1203.         end;
  1204.     TheItems^.AtInsert(Indx,New(PPgmItem,Init(PgmName,PgmFile,Dir,Params,Cmdshow)));
  1205.     end;
  1206. end;
  1207.  
  1208. procedure TOMCol.ItemGet(var PgmItem:ItemRec);
  1209. var
  1210.   Indx:Integer;
  1211.   IndxStr:Array[0..5] of Char;
  1212.   ErrCode:Integer;
  1213.   TheItem:PPgmItem;
  1214. begin
  1215.     Val(PgmItem.ItemNum,Indx,ErrCode);
  1216.   if (ErrCode <> 0) or (NOT(IsValidIndx(Indx))) then
  1217.       Exit;
  1218.   begin
  1219.   TheItem := TheItems^.At(Indx);
  1220.   If TheItem^.PgmName <> nil then
  1221.       StrCopy(PgmItem.PgmName,TheItem^.PgmName);
  1222.   If TheItem^.PgmFile <> nil then
  1223.       StrCopy(PgmItem.PgmFile,TheItem^.PgmFile);
  1224.   If TheItem^.Dir <> nil then
  1225.       StrCopy(PgmItem.Dir,TheItem^.Dir);
  1226.   If TheItem^.Params <> nil then
  1227.       StrCopy(PgmItem.Params,TheItem^.Params);
  1228.   If TheItem^.Cmdshow <> nil then
  1229.       StrCopy(PgmItem.CmdShow,TheItem^.Cmdshow);
  1230.     end;
  1231. end;
  1232.  
  1233. procedure TOMCol.ItemSet(PgmItem:ItemRec);
  1234. var
  1235.     Buf1:Array[0..30] of Char;
  1236.   Indx:Integer;
  1237.   IndxStr:Array[0..5] of Char;
  1238.   Found:Boolean;
  1239.   Key:Array[0..20] of Char;
  1240.   Errval:Integer;
  1241. begin
  1242.     Val(PgmItem.ItemNum,Indx,Errval);
  1243.   If IsValidIndx(Indx) then
  1244.       begin
  1245.       StrCopy(IndxStr,PgmItem.ItemNum) ;
  1246.     StrCat(StrCopy(Key,'PgmName'),IndxStr);
  1247.         WritePrivateProfileString('OM',Key,PgmItem.PgmName,IniFile);
  1248.     StrCat(StrCopy(Key,'PgmFile'),IndxStr);
  1249.         WritePrivateProfileString('OM',Key,PgmItem.PgmFile,IniFile);
  1250.     StrCat(StrCopy(Key,'Dir'),IndxStr);
  1251.         WritePrivateProfileString('OM',Key,PgmItem.Dir,IniFile);
  1252.     StrCat(StrCopy(Key,'Params'),IndxStr);
  1253.         WritePrivateProfileString('OM',Key,PgmItem.Params,IniFile);
  1254.     StrCat(StrCopy(Key,'CmdShow'),IndxStr);
  1255.         WritePrivateProfileString('OM',Key,PgmItem.CmdShow,IniFile);
  1256.     TheItems^.AtFree(Indx);
  1257.     TheItems^.AtInsert(Indx,New(PPgmItem,Init(PgmItem.PgmName,PgmItem.PgmFile,
  1258.         PgmItem.Dir,PgmItem.Params,PgmItem.Cmdshow)));
  1259.     end;
  1260. end;
  1261.  
  1262. function TOMCol.GetCount:Integer;
  1263. begin
  1264.     GetCount := TheItems^.Count;
  1265. end;
  1266.  
  1267. function TOMCol.IsValidIndx(Indx:Integer):Boolean;
  1268. begin
  1269.     IsValidIndx :=((Indx >= 0) and (Indx < TheItems^.Count));
  1270. end;
  1271. {************************  TOMRButton    *****************************}
  1272. procedure TOMRButton.WMRButtonDown(var Msg:TMessage);
  1273. begin
  1274.   SendMessage(Parent^.HWindow,wm_User+wm_RButtonDown,GetID,0);
  1275. end;
  1276. {*************************  TOMGroupBox     **************************}
  1277. procedure TOMGroupBox.SetupWindow;
  1278. begin
  1279.     TGroupBox.SetupWindow;
  1280.   DragAcceptFiles(HWindow,TRUE);
  1281. end;
  1282.  
  1283. function TOMGroupBox.CanClose:Boolean;
  1284. begin
  1285.     DragAcceptFiles(HWindow,FALSE);
  1286.     CanClose := TGroupBox.CanClose;
  1287. end;
  1288.  
  1289. procedure TOMGroupBox.WMDropFiles(var Msg:TMessage);
  1290. var
  1291.     DropItem:hDrop;
  1292.   FileNameBuf:Array[0..fsPathName] of Char;
  1293.   GFileName:PChar;
  1294.   CtrlID:Integer;
  1295.   Loc,SLoc:TPoint;
  1296.   ChildWin:HWnd;
  1297. begin
  1298.     DropItem := Msg.wParam;
  1299.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  1300.   GFileName :=StrNew(FileNameBuf);
  1301.   DragQueryPoint(DropItem,Loc);
  1302.   DragFinish(DropItem);
  1303.   SLoc := Loc;
  1304.   ClienttoScreen(HWindow,SLoc);
  1305.   ChildWin := WindowFromPoint(SLoc);
  1306.   CtrlID := GetDlgCtrlID(ChildWin);
  1307.   SendMessage(Parent^.HWindow,wm_User+wm_DropFiles,CtrlID,LongInt(GFileName));
  1308.   StrDispose(GFileName);
  1309. end;
  1310. {************************  TOMStatic    *****************************}
  1311. procedure TOMStatic.WMRButtonDown(var Msg:TMessage);
  1312. begin
  1313.   SendMessage(Parent^.HWindow,wm_User+wm_RButtonDown,GetID,0);
  1314. end;
  1315. {***********************  MainLine  ********************************}
  1316. var
  1317.     OMApp : TOMApplication;
  1318. begin
  1319.     OMApp.Init('OttoMenu');
  1320.   OMApp.Redraw;
  1321.     OMApp.Run;
  1322.     OMApp.Done;
  1323. end.
  1324.